home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / aprs30_2.zip / PLOTTER.BAS < prev    next >
BASIC Source File  |  1983-09-12  |  10KB  |  363 lines
  1. '***********************************************
  2. '*
  3. '*  Map digitizer program
  4. '*
  5. '*      By W7KKE
  6. '*
  7. '*      1 Sep 93
  8. '*
  9. '***********************************************
  10. CLS
  11. PRINT
  12. PRINT "This program converts digitizer coordinates to latitude and longitude"
  13. PRINT
  14. PRINT "A Mercator projection chart is expected. Other types, such as Lambert Conformal,"
  15. PRINT "Conical, etc., will induce distortions."
  16. PRINT
  17. PRINT "It has not been tested with East Longitude or South Latitude."
  18. PRINT
  19. PRINT "The expected digitzer is a GE Calma which uses a 4000 x 4000 grid"
  20. PRINT "with grid origin in the lower left corner. The max number of points"
  21. PRINT "the program will take for each map section, i.e. coastline, road, etc.,"
  22. PRINT "is set to 100."
  23. PRINT
  24.  
  25. startit:
  26. 'Clear all arrays and variables
  27.    CLEAR , , 4000' Increase stack size. Default stack size is 2048 bytes.
  28.  
  29. 'Set comport parameters
  30.     port$ = "COM2:"
  31.     baud$ = "9600"
  32.     parity$ = "E"
  33.  
  34.  
  35. 'Zero variables
  36. segm = 0
  37. i = 0
  38.  
  39. 'Dimension arrays for map
  40. DIM segcolor(75)
  41. DIM seglable$(75)
  42. DIM hiposit(75)
  43. DIM pixlat(75, 200)
  44. DIM pixlong(75, 200)
  45.  
  46. 'Dimension labels
  47. DIM lablat(100)
  48. DIM lablong(100)
  49. DIM labrng(100)
  50. DIM N$(100)
  51.  
  52.  
  53. PRINT
  54. PRINT "The serial port is currently configured for "; port$; " at "; baud$; " baud "; parity$; " parity."
  55. PRINT
  56. INPUT "Press <ENTER> to continue"; r$
  57. CLS
  58.  
  59. REM First establish scale on digitizer and x/y conversion.
  60. PRINT
  61. PRINT "Establish scale on digitizer."
  62. PRINT
  63. PRINT "The scale is established by two points, the first near the"
  64. PRINT "upper left corner, the second near the lower right corner."
  65. PRINT
  66. PRINT "Establish the upper left reference point:"
  67. INPUT "         Enter lat  (deg,min)"; latdeg1, latmin1
  68. INPUT "         Enter long (deg,min)"; longdeg1, longmin1
  69. PRINT
  70.  
  71. digion:
  72. REM Open digitizer port
  73.     portspec$ = port$ + baud$ + "," + parity$
  74.    OPEN portspec$ FOR INPUT AS #2
  75.  
  76. penget:      PRINT "Place digitizer pen on upper left point."
  77.       INPUT #2, in$
  78.       SOUND 150, 5
  79.       REM Following causes loop for debugging digitizer board
  80.         REM PRINT MID$(in$, 2, 4); " "; RIGHT$(in$, 4)
  81.         REM  GOTO penget
  82.         digix1 = 4000 - VAL(MID$(in$, 2, 4))
  83.         digiy1 = VAL(RIGHT$(in$, 4))
  84.         PRINT "Digitizer reads "; digix1, digiy1; " for this point."
  85.         PRINT
  86.  
  87. PRINT "Establish the lower right reference point:"
  88. INPUT "         Enter lat  (deg,min)"; latdeg2, latmin2
  89. INPUT "         Enter long (deg,min)"; longdeg2, longmin2
  90. PRINT
  91. PRINT "Place digitizer pen on lower right point."
  92.       INPUT #2, in$
  93.       SOUND 150, 5
  94.         digix2 = 4000 - VAL(MID$(in$, 2, 4))
  95.         digiy2 = VAL(RIGHT$(in$, 4))
  96.         PRINT "Digitizer reads "; digix2, digiy2; " for this point."
  97.         PRINT
  98.  
  99. REM Find delta lat/long between reference points
  100. REM Convert lat & long to decimal values from degrees and minutes
  101.  
  102.         dlat1# = latdeg1 + (latmin1 / 60)
  103.         dlong1# = longdeg1 + (longmin1 / 60)
  104.  
  105.         dlat2# = latdeg2 + (latmin2 / 60)
  106.         dlong2# = longdeg2 + (longmin2 / 60)
  107.  
  108. REM Calculate the difference in lat long for conversion factor
  109.         deltalat# = dlat1# - dlat2#
  110.         deltalong# = dlong1# - dlong2#
  111.  
  112. REM Calculate the X/Y difference between the two reference points.
  113.         deltadigx = digix1 - digix2
  114.         deltadigy = digiy1 - digiy2
  115.  
  116. REM Calculate degrees per x/y unit
  117.         degx# = deltalong# / deltadigx
  118.         degy# = deltalat# / deltadigy
  119.  
  120.  
  121. REM Now set up APRS specific map data
  122. PRINT
  123. PRINT "Large areas (Continents)  6 pixels per degree"
  124. PRINT "Large States/Regions     60 pixels per degree"
  125. PRINT "States                  120 pixels per degree"
  126. PRINT "Cities/Neighborhoods   1200 pixels per degree"
  127. PRINT "Fine detail            2400 pixes per degree"
  128. PRINT
  129. INPUT "Enter map scale in pixels"; pix
  130. PRINT
  131. PRINT "Using "; pix; " pixels per degree"
  132.  
  133. ' Calculate minimum zoom range to keep display from crashing
  134.  
  135.  IF pix <= 60 THEN minrng = 4
  136.  IF pix > 60 AND pix < 1200 THEN minrng = .5
  137.  IF pix >= 1200 THEN minrng = .25
  138.  
  139.  PRINT "Minimum map range will be "; minrng; " nm."
  140.  
  141.  
  142.  
  143. PRINT
  144. PRINT "Enter the origin lat/long for pixel 0/0 reference point"
  145. PRINT "(Use an even lat/long - no minutes, at upper left of map.)."
  146. INPUT "Enter latitude origin"; olat
  147. INPUT "Enter longitude origin"; olong
  148.  
  149. PRINT
  150.  
  151. centlatin:
  152. INPUT "Enter center latitude (deg,min)"; cenlatdeg, cenlatmin
  153.        IF cenlatdeg > 90 THEN GOTO centlatin
  154.        IF cenlatdeg < -90 THEN GOTO centlatin
  155.        IF centlatmin >= 60 THEN GOTO centlatin
  156.  
  157.  
  158. centlongin:
  159. INPUT "Enter center longitude (deg,min)"; cenlongdeg, cenlongmin
  160.        IF cenlogdeg > 180 THEN GOTO centlongin
  161.        IF cenlogdeg < -180 THEN GOTO centlongin
  162.        IF cenlongmin >= 60 THEN GOTO centlongin
  163.  
  164. 'Convert degrees & minutes to decimal degrees
  165.  
  166. dlat = cenlatdeg + (cenlatmin / 60)
  167. dlong = cenlongdeg + (cenlongmin / 60)
  168.  
  169. 'Save in unique variable name for file print routine
  170. cendlat = dlat
  171. cendlong = dlong
  172.  
  173. 'PRINT dlat, dlong   ' For debugging
  174.  
  175. PRINT
  176. INPUT "Enter map range (nm)"; maprng
  177. PRINT
  178.  
  179.  
  180. PRINT
  181. INPUT "Enter name for this map"; name$
  182. PRINT "Start entering points. Press 'F1' and tap digitizer pen on completion of data entry."
  183.      ON KEY(1) GOSUB getout
  184.  
  185. REM Start plotting points
  186. REM Continuous loop until F1 pressed
  187. enterseg:
  188. i = 0' zero individual point counter
  189. segm = segm + 1'Segment counter
  190. highseg = segm
  191. GOSUB getcolor
  192. segcolor(segm) = segcolor
  193. seglable$(segm) = r$
  194.  
  195.         PRINT "Point to first position on map"
  196.        KEY(1) ON
  197. getposits:
  198.        INPUT #2, in$
  199.         SOUND 150, 5
  200.         x = 4000 - VAL(MID$(in$, 2, 4))
  201.         y = VAL(RIGHT$(in$, 4))
  202.  
  203.         dlat# = ((y - digiy2) * degy#) + dlat2#
  204.         dlong# = ((x - digix2) * degx#) + dlong2#
  205.  
  206.         latmin = (dlat# - INT(dlat#)) * 60
  207.         longmin = (dlong# - INT(dlong#)) * 60
  208.  
  209. i = i + 1
  210. hiposit(segm) = i
  211. PRINT "Segment "; segm; " point "; i; " ";
  212.         PRINT INT(dlat#); " deg "; latmin; "'"; "  ";
  213.         PRINT INT(dlong#); " deg "; longmin; "'"
  214.  
  215. REM Convert lat/long to pixels
  216. GOSUB pixels:
  217.    pixlat(segm, i) = pixlat
  218.    pixlong(segm, i) = pixlong
  219.  
  220. GOTO getposits
  221. END  ' Should never get here
  222.  
  223. REM***********
  224.  
  225. labels:  'Routine to enter named labels on screen
  226. i = 0
  227. KEY(1) OFF
  228. CLS
  229. PRINT
  230. PRINT "Now starting entry of named geographic points for map."
  231.  
  232. entlabels:
  233.     i = i + 1
  234.     maxlabel = i
  235.     PRINT "Enter 'Q' for main menu"
  236.     INPUT "Label name"; N$(i)
  237.     IF N$(i) = "Q" OR N$ = "q" THEN GOTO getout
  238.     PRINT "Place pen at point and press. "
  239.        INPUT #2, in$
  240.         SOUND 150, 5
  241.         x = 4000 - VAL(MID$(in$, 2, 4))
  242.         y = VAL(RIGHT$(in$, 4))
  243.  
  244.         dlat# = ((y - digiy2) * degy#) + dlat2#
  245.         dlong# = ((x - digix2) * degx#) + dlong2#
  246.  
  247.         latmin = (dlat# - INT(dlat#)) * 60
  248.         longmin = (dlong# - INT(dlong#)) * 60
  249.  
  250.          dlat = dlat#
  251.          dlong = dlong#
  252.  
  253. PRINT "Segment "; segm; " point "; i; " ";
  254.         PRINT INT(dlat#); " deg "; latmin; "'"; "  ";
  255.         PRINT INT(dlong#); " deg "; longmin; "'"
  256.  
  257.    INPUT "Range scale you wish label to be displayed"; in
  258.    lablat(i) = dlat
  259.    lablong(i) = dlong
  260.    labrng(i) = in
  261.     PRINT
  262. GOTO entlabels
  263.  
  264. savsegs: 'Routine to save data to map file
  265.         CLS
  266.         CLOSE #2
  267.         INPUT "Enter name of map file (filename.map)"; r$
  268.         filename$ = r$
  269.         OPEN filename$ FOR OUTPUT AS #1
  270.  
  271.  
  272.         CLS
  273.         PRINT #1, olat; ", latitude of origin"
  274.         PRINT #1, olong; ", long of origin "
  275.         PRINT #1, pix; ", pixels per degree vert"
  276.         PRINT #1, cendlat; ", Latitude of map center"
  277.         PRINT #1, cendlong; ", Longitude of map center"
  278.         PRINT #1, maprng; ", Map range in miles"
  279.         PRINT #1, minrng; ", Min range for zoom function"
  280.         PRINT #1, name$
  281.  
  282.         FOR k = 1 TO highseg
  283.          PRINT #1, "0,0"   'End of line segment marker
  284.          PRINT #1, segcolor(k); ","; seglable$(k)
  285.            FOR l = 1 TO hiposit(k)
  286.             x = pixlong(k, l)
  287.             y = pixlat(k, l)
  288.             PRINT #1, STR$(x); ","; STR$(y)
  289.            NEXT l
  290.         NEXT k
  291.         PRINT #1, "0,-1"
  292.         PRINT #1, "0, Start map label data"
  293.  
  294.        'Print label data to file
  295.         FOR i = 1 TO maxlabel - 1
  296.           x = lablat(i)
  297.           y = lablong(i)
  298.           z = labrng(i)
  299.           PRINT #1, N$(i); ","; STR$(x); ","; STR$(y); ","; STR$(z)
  300. PRINT
  301.         NEXT i
  302.      CLOSE #1
  303.  
  304.  PRINT "Data saved as "; filename$
  305.  PRINT
  306. INPUT "Press enter to continue"; r$
  307. GOTO getout
  308.  
  309. END
  310.  
  311. 'SUBROUTINES
  312.  
  313. getcolor:  'Subroutine to select line segment color code
  314.  
  315.         PRINT "Use following color codes:"
  316.         PRINT "        Red (4) = secondary roads"
  317.         PRINT "        Bright red (12) = important highways"
  318.         PRINT "        Green (10) = interstates"
  319.         PRINT "        Light blue (11) = rivers & coastlines"
  320.         PRINT "        Orange (6) = city/county lines"
  321.         PRINT "        Purple (13) = special event routes"
  322.         PRINT
  323.         INPUT "Select color for this line segment"; segcolor
  324.         INPUT "Enter label for this segment"; r$
  325.  
  326.    RETURN
  327.  
  328. pixels:
  329.  
  330.         ' Find delta lat/long from zero/zero reference point
  331.        
  332.         deltalat = olat - dlat#
  333.         deltalong = olong - dlong#
  334.  
  335.         ' Convert the difference values into pixal values
  336.  
  337.      pixlat = INT(deltalat * pix)
  338.      pixlong = INT(deltalong * pix)
  339.  
  340.      PRINT "Longitude/Latitude X/Y in pixels ="; pixlong; " / "; pixlat
  341.      PRINT
  342.  
  343.    RETURN
  344.  
  345. getout: 'Subroutine to getout of entry routines
  346.        
  347.         KEY(1) OFF
  348.         CLS
  349.         PRINT "Select:"
  350.         PRINT "     1) Enter another segment"
  351.         PRINT "     2) Enter named points for display on map (do after all segments)"
  352.         PRINT "     3) Save data to file"
  353.         PRINT "     4) Zero arrays and restart program"
  354.         PRINT "     5) Return to DOS"
  355.         INPUT in
  356.         ON in GOTO enterseg, labels, savsegs, startit, leave
  357.  
  358. leave: 'exit to DOS
  359.    CLOSE #2
  360.    SYSTEM
  361.    END
  362.  
  363.